Crisis risk dashboard Asia-Pacific
Economic Stability
Migration
Migrant barchart
Migrant network graph
Sean Ng
August 10, 2024
---
title: "Crisis risk dashboard Asia-Pacific"
author: "Sean Ng"
date: "10 August 2024"
toc: false
format:
html:
page-layout: full
code-tools: true
self-contained: true
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE,
fig.width = 9.5)
library(tidyverse)
library(here)
library(lubridate)
library(patchwork)
library(scales)
library(sf)
library(broom)
library(treemapify)
library(kableExtra)
library(readxl)
library(countrycode)
library(viridis)
library(ggraph)
library(ggforce)
library(plotly)
library(widyr)
library(tidytext)
library(janitor)
library(ggiraph)
`%out%` <- Negate(`%in%`)
options(scipen = 100)
theme_set(theme_light())
show_col(viridis_pal(option = "cividis")(8))
country_list <- c("Afghanistan", "Bangladesh", "Bhutan", "Cambodia",
"China", "Fiji", "Hong Kong", "India", "Indonesia",
"Iran", "North Korea", "South Korea", "Laos",
"Malaysia", "Maldives", "Mongolia", "Myanmar",
"Nepal", "Pakistan", "Papua New Guinea", "Philippines",
"Solomon Islands", "Sri Lanka", "Thailand", "Timor-Leste",
"Vanuatu", "Vietnam")
world_shape <- st_read(here("data",
"world-administrative-boundaries",
"world-administrative-boundaries.shp"),
quiet = TRUE)
population_estimates <- read_csv(here("data", "population_estimates.csv")) |>
mutate(country_iso = countrycode(country,
origin = "country.name",
destination = "iso3c"))
range01 <- function(x){(x-min(x))/(max(x)-min(x))}
range_wna <- function(x){(x-min(x, na.rm = TRUE))/(max(x, na.rm = TRUE)-min(x, na.rm = TRUE))}
```
## Economic Stability
```{r}
econ_stab <- read_csv(here("data", "economic_stability_data.csv"))
# Correcting the wrong GDP per capita values
gdp <- read_csv(here("data", "gdp_per_capita.csv")) |>
clean_names() |>
filter(!is.na(country_code)) |>
mutate(country_name =
case_when(
str_detect(country_name, "Iran") ~ "Iran",
str_detect(country_name, "Micronesia") ~ "Micronesia",
country_name == "Viet Nam" ~ "Vietnam",
TRUE ~ country_name
))
```
```{r}
economic_stability <- econ_stab |>
filter(Indicator_SubType != "GDP per capita, PPP (constant 2017 international $)") |>
rbind(gdp |>
pivot_longer(cols = c(x2012_yr2012:x2023_yr2023),
names_to = "Year",
values_to = "Value") |>
mutate(Year = str_sub(Year, start = 2, end = 5),
Indicator_SubType = "GDP per capita (constant 2015 US$)") |>
select(Country_Name_Short = country_name,
Indicator_SubType,
Year,
Value) |>
mutate(Value = parse_number(Value),
Year = parse_double(Year)) |>
filter(!is.na(Value))) |>
group_by(Country_Name_Short, Indicator_SubType) |>
mutate(rescaled_value = range_wna(Value)) |>
ungroup() %>%
mutate(indicator_label =
case_when(
str_detect(Indicator_SubType, "Consumer price index") ~ "Consumer price index",
Indicator_SubType == "GDP per capita (constant 2015 US$)" ~ "GDP per capita",
str_detect(Indicator_SubType, "Total debt service") ~ "Total debt service",
str_detect(Indicator_SubType, "Inflation") ~ "Inflation annual",
TRUE ~ Indicator_SubType
),
Value = case_when(Value <= 100 ~ round(Value, digits = 2),
Value > 100 ~ (round(Value))),
label = paste0(indicator_label, "\n",
"Year: ", Year, "\n",
"Value: ", Value)) |>
filter(indicator_label != "Consumer price index") |>
ggplot(aes(x = Year, y = rescaled_value, group = indicator_label)) +
geom_line(aes(colour = indicator_label,
tooltip = label)) +
scale_colour_manual(values = c("#35B779FF", "#440154FF", "#EDD03AFF")) +
scale_x_continuous(breaks = seq(2012, 2024, 2)) +
facet_wrap(~ Country_Name_Short, ncol = 6) +
labs(title = "Macroeconomic indicator trends; hover for details",
colour = "",
y = "Rescaled value",
x = "",
caption = "Source: World Bank") +
theme(legend.position = "top",
axis.text.x = element_text(angle = 40, hjust = .8, vjust = 1, size = 6),
axis.text.y = element_text(size = 6),
plot.caption = element_text(hjust = .5),
strip.background = element_rect(fill = "black"),
element_text(size=6),
plot.title = element_text(size = 11))
```
```{r fig.height=8}
ggplotly(economic_stability,
autosize = F,
height = 800,
width = 1000,
tooltip = c("tooltip")) |>
layout(legend = list(orientation = "h", x = 0, y = 1.15),
title = list(x = 0, y = 1.01))
```
<br><br><br>
```{r fig.height=8}
economic_stability_alt <- econ_stab |>
filter(Indicator_SubType != "GDP per capita, PPP (constant 2017 international $)") |>
rbind(gdp |>
pivot_longer(cols = c(x2012_yr2012:x2023_yr2023),
names_to = "Year",
values_to = "Value") |>
mutate(Year = str_sub(Year, start = 2, end = 5),
Indicator_SubType = "GDP per capita (constant 2015 US$)") |>
select(Country_Name_Short = country_name,
Indicator_SubType,
Year,
Value) |>
mutate(Value = parse_number(Value),
Year = parse_double(Year)) |>
filter(!is.na(Value))) |>
group_by(Country_Name_Short, Indicator_SubType) |>
mutate(rescaled_value = range_wna(Value)) |>
ungroup() %>%
mutate(indicator_label =
case_when(
str_detect(Indicator_SubType, "Consumer price index") ~ "Consumer price index",
Indicator_SubType == "GDP per capita (constant 2015 US$)" ~ "GDP per capita",
str_detect(Indicator_SubType, "Total debt service") ~ "Total debt service",
str_detect(Indicator_SubType, "Inflation") ~ "Inflation annual",
TRUE ~ Indicator_SubType
),
Value = case_when(Value <= 100 ~ round(Value, digits = 2),
Value > 100 ~ (round(Value))),
label = paste0(indicator_label, "\n",
"Year: ", Year, "\n",
"Value: ", Value)) |>
filter(indicator_label != "Consumer price index") |>
ggplot(aes(x = Year, y = rescaled_value, group = indicator_label)) +
geom_line_interactive(aes(colour = indicator_label,
tooltip = label)) +
scale_colour_manual(values = c("#35B779FF", "#440154FF", "#EDD03AFF")) +
scale_x_continuous(breaks = seq(2012, 2024, 2)) +
facet_wrap(~ Country_Name_Short, ncol = 6) +
labs(title = "Macroeconomic indicator trends; hover for details",
colour = "",
y = "Rescaled value",
x = "",
caption = "Source: World Bank") +
theme(legend.position = "top",
axis.text.x = element_text(angle = 40, hjust = .8, vjust = 1, size = 6),
axis.text.y = element_text(size = 6),
plot.caption = element_text(hjust = .5),
strip.background = element_rect(fill = "black"),
element_text(size=6),
plot.title = element_text(size = 11))
girafe(ggobj = economic_stability_alt,
options = list(opts_tooltip(use_fill = TRUE)))
```
```{r}
websites <- tribble(
~ref, ~url,
"economic_stability_barchart", "<iframe src='https://risk-anticipation-hub.github.io/crisis_risk_dashboard/interactive_plots.html#htmlwidget-ce5e08db6fad6f468036' style = 'width:100%;height:100vh;'></iframe?>",
"migration_barchart",
"<iframe src='https://risk-anticipation-hub.github.io/crisis_risk_dashboard/interactive_plots.html#htmlwidget-b187a3b213c2b014f28a' style = 'width:100%;height:100vh;'></iframe?>",
"economic_stability_alternative", "<iframe src='https://risk-anticipation-hub.github.io/crisis_risk_dashboard/interactive_plots.html#economic-stability' style = 'width:100%;height:100vh;'></iframe?>"
)
websites |> write_csv(here("data", "websites.csv"))
```
## Migration
```{r}
aggregation_list <- c("AFRICA",
"ASIA",
"Central and Southern Asia",
"Central America",
"Central Asia",
"EUROPE",
"Eastern Africa",
"Eastern Asia",
"Eastern Europe",
"Eastern and South-Eastern Asia",
"High-income countries",
"LATIN AMERICA AND THE CARIBBEAN",
"Land-locked Developing Countries (LLDC)",
"Latin America and the Caribbean",
"Least developed countries",
"Less developed regions",
"Less developed regions, excluding China",
"Less developed regions, excluding least developed countries",
"Low-income countries",
"Lower-middle-income countries",
"Middle-income countries",
"Middle Africa",
"NORTHERN AMERICA",
"Northern Africa",
"Northern Africa and Western Asia",
"Northern Europe",
"OCEANIA",
"Oceania (excluding Australia and New Zealand)",
"Small island developing States (SIDS)",
"Sub-Saharan Africa",
"Upper-middle-income countries",
"Western Africa",
"Western Asia",
"Western Europe",
"Western Sahara",
"WORLD",
"Australia and New Zealand",
"Europe and Northern America",
"Developed regions",
"South-Eastern Asia",
"Southern Asia",
"Southern Europe",
"Caribbean",
"South America",
"Other",
"Southern Africa",
"Melanesia",
"Micronesia",
"Polynesia")
```
```{r warning=FALSE}
migrant <- read_excel(here("data", "undesa_pd_2020_ims_stock_by_sex_destination_and_origin.xlsx"),
sheet = 2,
skip = 8) |>
janitor::clean_names() |>
pivot_longer(cols = 8:28,
names_to = "name",
values_to = "value") |>
mutate(name = str_replace(name, "x", ""))|>
mutate(sex = case_when(
name %in% c("1990_8", "1995_9", "2000_10", "2005_11",
"2010_12", "2015_13", "2020_14") ~ "total",
name %in% c("1990_15", "1995_16", "2000_17", "2005_18",
"2010_19", "2015_20", "2020_21") ~ "male",
name %in% c("1990_22", "1995_23", "2000_24", "2005_25",
"2010_26", "2015_27", "2020_28") ~ "female",
TRUE ~ "wrong"
)) |>
mutate(year = as.numeric(str_sub(name, start = 1L, end = 4L))) |>
rename(area_of_destination = region_development_group_country_or_area_of_destination,
area_of_origin = region_development_group_country_or_area_of_origin) %>%
mutate_at(vars(area_of_destination, area_of_origin),
.funs = ~str_replace_all(., "\\*", "")) |>
mutate(aggregation = ifelse(
area_of_origin %in% aggregation_list |
area_of_destination %in% aggregation_list,
"yes", "no"
)) %>%
mutate_at(vars(area_of_destination,
area_of_origin),
.funs = ~case_when(
. == "China, Hong Kong SAR" ~ "Hong Kong",
. == "Dem. People's Republic of Korea" ~ "North Korea",
. == "Iran (Islamic Republic of)" ~ "Iran",
. == "Lao People's Democratic Republic" ~ "Laos",
. == "Republic of Korea" ~ "South Korea",
. == "Viet Nam" ~ "Vietnam",
TRUE ~ .
))
```
```{r}
migrant_stock_changes <- migrant |>
filter(aggregation == "no") |>
filter(area_of_destination %in% country_list |
area_of_origin %in% country_list) |>
filter(value != 0 & sex != "total") |>
group_by(area_of_origin, area_of_destination, year, sex) |>
summarise(migrants = sum(value, na.rm = TRUE), .groups = "drop") |>
pivot_wider(names_from = "year",
values_from = "migrants",
values_fill = 0,
names_prefix = "migrants_") |>
mutate(origin_iso = countrycode(area_of_origin,
origin = "country.name",
destination = "iso3c"),
destination_iso = countrycode(area_of_destination,
origin = "country.name",
destination = "iso3c")) |>
left_join(
population_estimates |>
filter(year %in% c(2000, 2010, 2015, 2020)) |>
pivot_wider(names_from = year,
values_from = population,
names_prefix = "origin_population_") |>
select(-country),
by = c("origin_iso" = "country_iso")) |>
left_join(
population_estimates |>
filter(year %in% c(2000, 2010, 2015, 2020)) |>
pivot_wider(names_from = year,
values_from = population,
names_prefix = "destination_population_") |>
select(-country),
by = c("destination_iso" = "country_iso")) |>
# Filtered small origin-destination pairs with small island territories without population data
# 9 rows total, minimal
filter(!is.na(origin_population_2020) & !is.na(destination_population_2020))
```
### Migrant barchart
```{r fig.height = 8}
migrant_bars <- migrant_stock_changes |>
group_by(area_of_origin, sex) |>
summarise(origin_population_2020 = mean(origin_population_2020),
migrants_2020 = sum(migrants_2020),
.groups = "drop") |>
mutate(migrants_pc = migrants_2020 / origin_population_2020 * 100) |>
arrange(desc(migrants_pc)) |>
filter(area_of_origin %in% country_list) |>
group_by(area_of_origin) |>
mutate(total_migrants_sort = sum(migrants_2020),
total_migrants_pc = total_migrants_sort / origin_population_2020) |>
ungroup() |>
mutate(area_of_origin = fct_reorder(area_of_origin, total_migrants_pc),
sex = str_to_title(sex),
tooltip = paste0("Origin: ", area_of_origin, ", ", sex, "\n",
"Migrants: ", comma(migrants_2020), "\n",
"% Migrated: ", round(migrants_pc, digits = 2))) |>
ggplot(aes(x = migrants_2020, y = area_of_origin,
tooltip = tooltip)) +
geom_col_interactive(aes(fill = migrants_pc)) +
scale_fill_viridis(direction = -1, end= .95) +
scale_x_continuous(labels = number_format(scale = 1 / 1000000, suffix = "M")) +
facet_row(vars(sex), scales = "free_x", space = "free") +
labs(title = "Number of persons who migrated, by country of origin, 2020",
fill = "% Migrated",
y = "",
x = "Number of migrants 2020",
caption = "Source: International Migrant Stock 2020") +
theme(legend.position = c(.9, .7),
strip.background = element_rect(fill = "black"),
legend.title = element_text(size = 7),
legend.text = element_text(size = 6),
plot.title = element_text(size = 11))
girafe(ggobj = migrant_bars,
options = list(opts_tooltip(use_fill = TRUE)))
```
## Migrant network graph
```{r}
test_df <- migrant_stock_changes |>
select(area_of_origin, area_of_destination, sex,
migrants_2020, origin_population_2020) |>
pivot_wider(names_from = "sex",
values_from = "migrants_2020",
values_fill = 0) |>
mutate(total_migrants_2020 = male + female,
sex_ratio = round(male * 100 / female),
sex_ratio = ifelse(is.infinite(sex_ratio), 0, sex_ratio),
sex_ratio = ifelse(is.nan(sex_ratio), 0, sex_ratio)) |>
arrange(desc(sex_ratio)) |>
filter(sex_ratio != 0) |>
mutate(n = 1,
origin_population_pc = round(total_migrants_2020 / origin_population_2020 * 100,
digits = 2)) |>
filter(total_migrants_2020 > 100000 | origin_population_pc > 3)
```
```{r fig.height=7}
set.seed(2243)
migrant_stock_changes |>
select(area_of_origin, area_of_destination, sex,
migrants_2020, origin_population_2020) |>
pivot_wider(names_from = "sex",
values_from = "migrants_2020",
values_fill = 0) |>
mutate(total_migrants_2020 = male + female,
sex_ratio = round(male * 100 / female),
sex_ratio = ifelse(is.infinite(sex_ratio), 0, sex_ratio),
sex_ratio = ifelse(is.nan(sex_ratio), 0, sex_ratio)) |>
arrange(desc(sex_ratio)) |>
filter(sex_ratio != 0) |>
mutate(n = 1,
origin_population_pc = round(total_migrants_2020 / origin_population_2020 * 100,
digits = 2)) |>
ungroup() |>
filter(total_migrants_2020 > 100000 | origin_population_pc > 3) |>
igraph::graph_from_data_frame() |>
ggraph(layout = "circle") +
geom_edge_link(aes(edge_width = total_migrants_2020,
alpha = origin_population_pc,
edge_colour = sex_ratio,
colour = sex_ratio),
lineend = "round",
check_overlap = TRUE) +
scale_edge_colour_gradient2(low = "#5DC863FF",
mid = "#F58C46FF",
high = "#0D0887FF",
midpoint = 1,
trans = "log10") +
scale_edge_width_continuous(range = c(.1, 7),
labels = number_format(scale = 1 / 1000000,
suffix = "M"),
breaks = c(500000, 1000000, 2000000, 3000000)) +
scale_alpha_continuous(range = c(.5, 1)) +
geom_node_text(aes(label = name), size = 3) +
geom_node_point(alpha = 0.1) +
labs(title = "Origins and destinations of Asia-Pacific migrants in 2020",
subtitle = "Thickness of line indicates number of migrants, trasparency indicates % of origin population migrated,\nSex ratio is # of males per 100 females. Only displaying the top origin-destination pairs",
caption = "Source: International Migrant Stock 2020",
edge_width = "No. Migrants",
edge_colour = "Sex ratio",
edge_alpha = "% Migrated") +
theme(legend.key.size = unit(.48, "cm"),
legend.title = element_text(size = 8),
legend.text = element_text(size = 7),
plot.subtitle = element_text(size = 10),
plot.title = element_text(size = 11))
```